home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 65.zip / BS1 part 65 / Prof Draw 3.0 disk 1.adf / pdraw_rex.lzh / CopyObjectAttr.pdrx < prev    next >
Text File  |  1992-06-16  |  3KB  |  114 lines
  1. /*
  2. @N
  3.  
  4. This Genie will copy the attributes of one object to of a selection of objects.
  5.  
  6. */
  7. msg = PDSetup.rexx(2,0)
  8. units = getclip(pds_units)
  9. if msg ~= 1 then exit_msg(msg)
  10.  
  11. signal on error
  12. signal on syntax
  13.  
  14. cr = '0a'x
  15.  
  16. commands.1 = "Position"
  17. commands.2 = "Size"
  18. commands.3 = "_Line Color"
  19. commands.4 = "_Line Pattern"
  20. commands.5 = "_Fill Pattern"
  21. commands.6 = "Line Weight"
  22. commands.7 = "_Line Join"
  23. commands.8 = "Lock"
  24.  
  25. prompt = ''
  26.  
  27. do i = 1 to 7
  28.    prompt = prompt || cr || commands.i
  29.    if left(commands.i,1) = '_' then commands.i = substr(commands.i,2)
  30. end
  31.  
  32. prompt = substr(prompt, 2)
  33.  
  34. obj = pdm_SelFirstobj()
  35. if obj = 0 then exit_msg("Please Select the objects whose attributes are to be changed, before executing this genie.")
  36.  
  37. source = pdm_ClickOnObj("Click on object to copy attributes from..")
  38. if source = 0 then exit_msg()
  39.  
  40. response = pdm_SelectFromList("Select attributes to copy..",30,7,1,prompt)
  41. if response = '' then exit_msg()
  42.  
  43. do while response ~= ''
  44.    parse var response command '0a'x response
  45.    if command = commands.1 then do
  46.       p = pdm_GetObjPosn(source)
  47.       x = word(p,1)
  48.       y = word(p,2)
  49.       o = pdm_selfirstobj()
  50.       do while o ~= 0
  51.          call pdm_SetObjPosn(o,x,y)
  52.          o = pdm_selnextobj(o)
  53.       end
  54.    end
  55.    else if command = commands.2 then do
  56.       p = pdm_GetObjVisSize(source)
  57.       x = word(p,1)
  58.       y = word(p,2)
  59.       o = pdm_selfirstobj()
  60.       do while o ~= 0
  61.          call pdm_SetObjVisSize(o,x,y)
  62.          o = pdm_selnextobj(o)
  63.       end
  64.    end
  65.    else if command = commands.3 then do
  66.       p = pdm_GetLineColor(source)
  67.       p = pdm_SetLineColor(,p)
  68.    end
  69.    else if command = commands.4 then do
  70.       p = pdm_GetLinePattern(source)
  71.       p = pdm_SetLinePattern(,word(p,1),subword(p,2))
  72.    end
  73.    else if command = commands.5 then do
  74.       p = pdm_GetFillPattern(source)
  75.       parse var p ty '0a'x c1 '0a'x c2 '0a'x st '0a'x an '0a'x cx '0a'x cy
  76.       p = pdm_SetFillPattern(,ty,c1,c2,st,an,cx,cy)
  77.    end
  78.    else if command = commands.6 then do
  79.       p = pdm_GetLineWeight(source)
  80.       p = pdm_SetLineWeight(,p)
  81.    end
  82.    else if command = commands.7 then do
  83.       p = pdm_GetLineJoin(source)
  84.       call pdm_SetLineJoin(,p)
  85.    end
  86.    else if command = commands.8 then do
  87.       p = pdm_islocked(source)
  88.       p = pdm_SetObjLock(,p)
  89.    end
  90. end
  91.  
  92. call exit_msg()
  93.  
  94.  
  95.  
  96. error:
  97. syntax:
  98. do
  99.     exit_msg("Genie failed due to error: "errortext(rc))
  100. end
  101.  
  102. exit_msg: procedure expose units
  103. do
  104.     parse arg message
  105.  
  106.     if message ~= '' then
  107.         call pdm_Inform(1, message,)
  108.  
  109.    call pdm_ClearStatus()
  110.    call pdm_SetUnits(units)
  111.     call pdm_AutoUpdate(1)
  112.     exit
  113. end
  114.